PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/mortpay.com/MORTPAY.PAS

Pascal/Delphi Source File | 1989-06-10 | 8.6 KB | 280 lines

program MortgagePaymentSchedule;{MORTPAY.PAS}

            {Assumes a mortgage is to be paid off in equal monthly payments over a
specified number of months and based on a constant annual interest rate, one
twelth of which is charged each month on the remaining balance.  While this
program is written for a constant interest rate and number of payments, the
balance in any month, together with a new interest rate and a new monthly
payment, can be used to compute a new mortgage schedule for variable rate
mortgages.}

            {Note the const values in procedure InputData which are used to
validate input data. They may be changed to more restrictive or to less
restrictive values if more appropriate for the user.  I suggest retaining
the LoInt value to ensure that the annual interest is entered as a percent
instead of as a decimal fraction less than 1.0.  The MaxBal and MaxPay are
related in a general way; if one is changed it may be prudent to change the
other.  Note, however, that it is possible to exceed MaxPay by entering a
large MaxBal and a small number of months to pay.  Similiarly, it is
possible to exceed MaxMon by entering a large MaxBal and a small monthly
payment.}

uses
    crt,printer;

const
    D9='---------';         {9 dashes}
    D11='-----------';      {11 dashes}
    Bal0=10e-3;             {Close approximation to zero}
var
    Num,BegMon,Y,k:integer;
            {Num is the number of payments of number of months.  BegMon is the
first month of the calendar year is which payment is due.  Y is the current
calendar year.  k is an index for counting calendar years.}

    Bal,AIR,Pay,Interest,Prin:real;
            {Bal is the unpaid balance of the principal.  AIR is the annual
interest rate in %.  Interest is interest calculated monthly on unpaid
balance.  Prin is the amount of principal which is deducted from the balance
is the given month and is equal to the monthly payment minus the interest
for that month.}

    PrtChoice,ch:Char;
            {PrtChoice determines whether to send output to printer.  ch is a
dummy variable.}

    Abort:boolean;
            {Abort is a flag to determine whether to terminate program before
running.}


procedure DisplayDashLine;  {Inserts dashed lines in display}

  begin
        writeln(D11:25,D9:10,D9:10,D9:10,D9:10)
    end;


procedure PrintDashLine;  {Inserts dashed lines in print out}

  begin
        writeln(Lst,D11:25,D9:10,D9:10,D9:10,D9:10)
    end;


procedure InputData;

    const               {Ranges of values to assist in validating input}
    MinBal=10.0;
        MaxBal=250000.0;
        LoInt=1.0;        {Lowest annual interest rate in %}
        HiInt=20.0;       {Highest annual interest rate in %}
    MinPay=1.0;
        MaxPay=3000.0;    {Max monthly payment}
        MinMon=1;
        MaxMon=30*12;     {Max number of months of loan}
        LoY=1950;           {Earliest beginning year}
        HiY=2020;           {Latest beginning year}

        BadEnt='Invalid entry; please try again.';

    var
        Choice:char;
            {Choice determines whether monthly payment of number of
payments/months are entered.}

    begin
        Bal:=0;AIR:=0;Pay:=0;Num:=0;BegMon:=0;Y:=1900;          {Initialization}
        Choice:='x';                                            {initialization}

        writeln;
        writeln('To terminate program during data input, enter -1.');
    writeln;

        Abort:=false;
    while not((Bal>=MinBal) and (Bal<=MaxBal)) and (Abort=false) do
    begin
            write('Enter balance owed:  ':55);
      readln(Bal);
            if Bal=-1 then Abort:=true
      else if not((Bal>=MinBal) and (Bal<=MaxBal)) then
        writeln(BadEnt)
        end;  {while do re Bal}

        while not((AIR>=LoInt) and (AIR<=HiInt)) and (Abort=false) do
    begin
            write('Enter annual interest rate in percent:  ':55);
      readln(AIR);
      if AIR=-1 then Abort:=true
      else if not((AIR>=LoInt) and (AIR<=HiInt)) then writeln(BadEnt)
        end;  {while do re AIR}

        while ((Choice<>'p') and (Choice<>'m')) and (Abort=false) do
        begin
            writeln;
            writeln('You may enter either the monthly payment');
            writeln('    or the number of months to pay.');
            write('Enter p (for payment) or m (for months):  ');
            readln(Choice);
            writeln;
        end;  {while do re Choice}

        if Choice='p' then
        begin
            while not((Pay>=MinPay) and (Pay<=MaxPay)) and (Abort=false) do
            begin
                write('Enter monthly payment:  ':55);
                readln(Pay);
                if Pay=-1 then Abort:=true
                else if not((Pay>=MinPay) and (Pay<=MaxPay)) then writeln(BadEnt)
            end;  {while do re Pay}
        end  {if Choice}

        else
        begin
            while not((Num>=MinMon) and (Num<=MaxMon)) and (Abort=false) do
            begin
                write('Enter number of months to pay:  ':55);
                readln(Num);
                if Num=-1 then Abort:=true
                else if not((Num>=MinMon) and (Num<=MaxMon)) then writeln(BadEnt)
                else Pay:=int(Bal*AIR/12/(1-exp(-Num*ln(1+AIR/1200)))+1)/100.0
            end;  {while do re Num}
        end;  {else}

        while not((BegMon>0) and (BegMon<13)) and (Abort=false) do
    begin
            write('Enter first month (1 to 12) in which payment due:  ':55);
      readln(BegMon);
      if BegMon=-1 then Abort:=true
      else if not((BegMon>0) and (BegMon<13)) then writeln(BadEnt)
    end; {while do re BegMon}

        while not((Y>=LoY) and (Y<=HiY)) and (Abort=false) do
      begin
            write('Enter first year in which payment is due:  ':55);
      readln(Y);
      if Y=-1 then Abort:=true
      else if not((Y>=LoY) and (Y<=HiY)) then writeln(BadEnt)
        end;  {while do re Y}

        write('Print hard copy (y/n)?  ':55);
        readln(PrtChoice);
    end;  {procedure InputData}


procedure DisplayHeading;

  begin
        writeln; writeln; writeln;
        writeln('MORTGAGE PAYMENT SCHEDULE':53);
        writeln('(':27,AIR:4:2,'% Annual Interest Rate)');
        writeln;
        writeln('Payment':35,'Interest':10,'Principal':10,
                'Balance':10);
        DisplayDashLine;
        writeln(Bal:65:2)
    end;


procedure PrintHeading; {Includes printing of current balance owed.}

  begin
        write(Lst,#10#10#10#10#10);          {to provide 5 vertical spaces}
        writeln(Lst,'MORTGAGE PAYMENT SCHEDULE':53);
        writeln(Lst,'(':27,AIR:4:2,'% Annual Interest Rate)':23);
        writeln(Lst);
        writeln(Lst,'Payment':35,'Interest':10,'Principal':10,
                'Balance':10);
        PrintDashLine;
    writeln(Lst,Bal:65:2)
    end;


procedure CalendarYearResults;

  const
        Mon:array[1..12] of string[3]=('Jan','Feb','Mar','Apr','May',
             'Jun','Jul','Aug','Sep','Oct','Nov','Dec');

  type
    Month=string[3];

  var
    CurMon:Month;
        j:1..13;                           {Counter for month of calendar year.}
    PayYTD,IntYTD,PrinYTD:real;

  begin
        j:=BegMon;                                              {Initialization}
        PayYTD:=0;IntYTD:=0;PrinYTD:=0;                         {Initialization}
        Bal:=int(Bal*100.0+0.5)/100.0;      {To ensure Bal begins on whole cent}

        while (j>=1) and (j<=12) and (Bal>Bal0) do
    begin
      Interest:=int(Bal*AIR/12+0.5)/100;
      Prin:=Pay-Interest;
      if Prin>Bal then
      begin
        Prin:=Bal;
        Pay:=Interest+Bal
            end;  {if Prin>Bal}
      Bal:=Bal-Prin;
      CurMon:=Mon[j];
            writeln(CurMon:17,Pay:18:2,Interest:10:2,Prin:10:2,Bal:10:2);
            if (PrtChoice='y') or (PrtChoice='Y') then
                writeln(Lst,CurMon:17,Pay:18:2,Interest:10:2,Prin:10:2,Bal:10:2);
            PayYTD:=PayYTD+Pay;
      IntYTD:=IntYTD+Interest;
      PrinYTD:=PrinYTD+Prin;
      j:=j+1
        end;  {while do re j}
        DisplayDashLine;
        writeln(Y:18,'Totals':7,PayYTD:10:2,IntYTD:10:2,PrinYTD:10:2,Bal:10:2);
        writeln;
        if (PrtChoice='y') or (PrtChoice='Y') then
        begin
            PrintDashLine;
            writeln(Lst,Y:18,'Totals':7,PayYTD:10:2,IntYTD:10:2,PrinYTD:10:2,
                    Bal:10:2);
            writeln(Lst);
        end  {if PrtChoice}
  end; {procedure CalendarYearResults}


begin {program block}
  InputData;
  if Abort=false then
  begin
        DisplayHeading;
        if (PrtChoice='y') or (PrtChoice='Y') then PrintHeading;
        k:=0;
        while Bal>Bal0 do
        begin
            CalendarYearResults;
            BegMon:=1;Y:=Y+1;k:=k+1;
            if (PrtChoice='y') or (PrtChoice='Y') then
                if (k mod 3=0) and (Bal>Bal0) then
                begin
                    write(Lst,#12);                                  {goto a new page}
                    PrintHeading;
                end;  {if k mod 3=0}
            if (PrtChoice<>'y') and (PrtChoice<>'Y') and (Bal>Bal0) then
            begin
                writeln('Press any key to continue...');
                ch:=ReadKey;
                writeln;writeln;writeln;
                DisplayHeading;
            end  {if PrtChoice<>}
        end;  {while Bal>Bal0 do}
        if (PrtChoice='y') or (PrtChoice='Y') and (Bal<Bal0) then
            write(Lst,#12);
    end  {if Abort=false}
  else
    begin
        writeln;
        writeln('Program terminated before running.');
        writeln;
    end
end.  {program block}